home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / ptg120co.zip / BBERROR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-11-06  |  3KB  |  32 lines
  1. (* This file was mangled by Mangler 1.13 (c) Copyright 1993 by Berend de Boer *)
  2.  {$IFDEF DPMI} {$S-,Q-,R-,I-,V-} {$ELSE} {$O+,F+,R-,Q-,S-,V-,I-} {$ENDIF} UNIT BBERROR ;INTERFACE USES DOS ;
  3. CONST FATALERRORTEXT :STRING [ 128 ] ='Fatal error. Errorcode: ';VAR FERR :TEXT ;PROCEDURE DUMPSTACK (STARTFRAME :WORD );
  4. PROCEDURE LOGERROR (CONST S :STRING );PROCEDURE INSTALLEXITHANDLER (AFILENAME :PATHSTR );IMPLEMENTATION USES OBJECTS ,
  5. MEMORY , {$IFDEF DPMI} WINAPI , {$ENDIF} BBUTIL , BBFILE , BBGUI ;VAR O1lO11Il00lI:POINTER;OIO1OO11I1:WORD;
  6. PROCEDURE DUMPSTACK (STARTFRAME:WORD);{$IFDEF DPMI} CONST O1l1l0Ill101=10 ;{$ENDIF} VAR {$IFDEF DPMI} OIOI10l10:WORD;
  7. {$ENDIF} O101O01III1II:WORD;OOlIll00OOll:POINTER;OOI1llO101l1:WORD;O10OO0IIl00II:INTEGER;BEGIN IF NOT FILEOPEN (FERR
  8. )THEN EXIT ;WRITELN (FERR , '**Stack dump**');IF STARTFRAME =0 THEN ASM {} MOV STARTFRAME, BP {} END;WRITELN (FERR ,
  9. 'startframe = ', HEXSTR (STARTFRAME ));WRITELN (FERR , 'Next frame   Caller');{$IFDEF DPMI} OIOI10l10 := GETSELECTORLIMIT
  10. (SSEG );{$ENDIF} O101O01III1II := STARTFRAME ;O10OO0IIl00II := 0 ;WHILE {$IFDEF DPMI} ((O101O01III1II MOD 2 =0 )AND
  11. (O101O01III1II < OIOI10l10 - 4 ))OR (O10OO0IIl00II >= O1l1l0Ill101 ){$ENDIF} {$IFDEF MSDOS} O101O01III1II <> 0 {$ENDIF}
  12.  DO BEGIN ASM {} MOV BX , O101O01III1II{} MOV AX , SS : [ BX ] {} MOV CX , AX {} SHR CX , 1 {} JNC @@1 {} DEC AX {}
  13. @@1 : {} MOV O101O01III1II, AX {} MOV AX , SS : [ BX + 2 ] {} MOV WORD PTR OOlIll00OOll, AX {}
  14. MOV AX , SS : [ BX + 4 ] {} MOV WORD PTR OOlIll00OOll+ 2 , AX {} {} CMP AX , 0 {} JE @skip {} {$IFDEF DPMI} {} VERR AX {}
  15. JE @getlogicalsel {} INC O10OO0IIl00II{} JMP @skip {} {$ENDIF} {} @getlogicalsel : {} MOV ES , AX {}
  16. MOV AX , WORD PTR ES : [ 0 ] {} @skip : {} MOV OOI1llO101l1, AX {} END;{$IFDEF DPMI} WRITELN (FERR , HEXSTR
  17. (O101O01III1II ), SPC (3 + 6 ), HEXSTR (OOI1llO101l1 ), ':', HEXSTR (PTRREC (OOlIll00OOll ). OFS ), '  (', HEXSTR (PTRREC
  18. (OOlIll00OOll ). SEG ), ')');{$ENDIF} {$IFDEF MSDOS} WRITELN (FERR , HEXSTR (O101O01III1II ), SPC (3 + 6 ), HEXSTR
  19. (PTRREC (OOlIll00OOll ). SEG ), ':', HEXSTR (PTRREC (OOlIll00OOll ). OFS ));{$ENDIF} END ;END ;PROCEDURE LOGERROR
  20. (CONST S:STRING );BEGIN IF FILEOPEN (FERR )THEN WRITELN (FERR , GETDATESTR , ' ', GETTIMESTR , '  ', S );END ;
  21. PROCEDURE OIO0OO1100O ;FAR ;VAR OIOO:WORD;OIO1OO11I1:WORD;BEGIN ASM {} MOV OIO1OO11I1, BP {} END;EXITPROC := O1lO11Il00lI
  22. ;OIOO := IORESULT ;IF EXITCODE =0 THEN BEGIN WRITELN (FERR , 'Program ended on ', GETDATESTR , ' at ', GETTIMESTR );
  23. CLOSE (FERR );EXIT ;END ;WRITELN (FERR , 'date = ', GETDATESTR );WRITELN (FERR , 'time = ', GETTIMESTR );WRITELN (FERR ,
  24. 'Errorcode = ', EXITCODE );WRITELN (FERR , 'Erroraddr = ', HEXSTR (PTRREC (ERRORADDR ). SEG ), ':', HEXSTR (PTRREC
  25. (ERRORADDR ). OFS ));WRITELN (FERR , 'MaxAvail = ', MAXAVAIL );WRITELN (FERR , 'MemAvail = ', MEMAVAIL );DUMPSTACK
  26. (OIO1OO11I1 );CLOSE (FERR );APPEND (FERR );INFOBOX (FATALERRORTEXT + STRW (EXITCODE ), 0 );CLOSE (FERR );END ;
  27. {$IFDEF DPMI} FUNCTION O1011I1OlOIO1 (OI1OIIIl0lO1:WORD):INTEGER ;FAR ;BEGIN O1011I1OlOIO1 := 1 ;END ;{$ENDIF}
  28. PROCEDURE INSTALLEXITHANDLER (AFILENAME:PATHSTR);BEGIN O1lO11Il00lI := EXITPROC ;EXITPROC := @ OIO0OO1100O ;ASSIGN (FERR
  29. , AFILENAME );IF NOT FILEEXIST (AFILENAME )THEN REWRITE (FERR )ELSE APPEND (FERR );WRITELN (FERR );WRITELN (FERR ,
  30. '** Program started on ', GETDATESTR , ' at ', GETTIMESTR , ' **');{$IFDEF DPMI} HEAPERROR := @ O1011I1OlOIO1 ;{$ENDIF}
  31. END ;END .
  32.